unit uBaseCalcForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls;

type
  TBaseCalcFormClass = class of TfmBaseCalcForm;

  TfmBaseCalcForm = class(TForm)
  private
    { Private declarations }
    FLock: integer;
  protected
    function CheckField(Obj: TLabeledEdit): single;
    function CheckFieldMore(Obj: TLabeledEdit; const vmin: single): boolean;
    function CheckFieldRange(Obj: TLabeledEdit; const vmin,vmax: single; IncEqu: boolean): boolean;
    function CheckField2(Obj: TLabeledEdit; out Value: single): boolean; overload;
    function CheckField2(Obj: TLabeledEdit; out Value: single; const vmin,vmax: single): boolean; overload;
    function CheckErrorField(Obj: TLabeledEdit; ASuccess: boolean): boolean;
    procedure HighliteErrorField(Obj: TLabeledEdit; AError: boolean = true);
    procedure LoadPictureFromRes(APic: TPicture; const AResName: string);

    procedure SetLabels(ABaseName, ACaption, AUnit: string);
    procedure ClearSet(ABaseName: string; ADefault: string = '');
    procedure EnableSet(ABaseName: string; AEnable: boolean);
    procedure ShowSet(ABaseName: string; AShow: boolean);

    property LockCount: integer read FLock;
    procedure LockFields;
    procedure UnlockFields;

    procedure DoFieldChanged;
    function DoCheckFields: boolean; virtual;
    procedure FieldsChanged; virtual;

    function GetLocaleString(AStringId: string): string;
    procedure LocalizeStrings(AObj: TStrings; ALocal: boolean = true);
    procedure LocalizeListColumns(AObj: TListView; ALocal: boolean = true);
    procedure RemoveListDupes(AObj: TListView);
  public
    { Public declarations }
    class function CalcFriendlyName: string; virtual;
    class function CalcSection: string; virtual;
    class function RunKey: string; virtual;
    // True if debug version of a module (not visible if --debug param is not specified)
    class function IsDebug: boolean; virtual;
    class procedure InvokeCalc; virtual;

    procedure AfterConstruction; override;

    function MessageBox(AText, ATitle: string; AFlags: integer): integer;
  end;

var
  fmBaseCalcForm: TfmBaseCalcForm;

function AppDir: string;
function keyExists(AKey: string): boolean;

function Between(v,a,b: single; inc_equ: boolean): boolean;

function NextToken(var S: string; tk: string): string;

implementation

{$R *.dfm}

uses StrUtils, MainForm, uLocalization;

function AppDir: string;
begin
  Result := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName));
end;

function Between(v,a,b: single; inc_equ: boolean): boolean;
begin
  if (inc_equ) then Result := (v>=a) and (v<=b)
  else Result := (v>a) and (v<b);
end;

function keyExists(AKey: string): boolean;
var i: integer;
begin
  Result := false;
  for i := 1 to Paramcount do
    if SameText(ParamStr(i), AKey) then begin
      Result := true; exit;
    end;
end;

function NextToken(var S: string; tk: string): string;
var i,l,tl: integer;
begin
  s := Trim(s);
  i := 1;
  l := Length(s);
  tl := Length(tk);
  while (i<=l) and (not AnsiSameText(copy(S,i,tl), tk)) do Inc(I);
  if (i>l) then begin
    Result := S;
    S := '';
  end else begin
    Result := Copy(S, 1, I-1);
    Delete(S,1,I);
  end;
end;

{ TfmBaseCalcForm }

procedure TfmBaseCalcForm.AfterConstruction;
begin
  inherited;
  Caption := GetString('#'+RunKey+'\title', false);
  if (Caption='') then Caption := Self.CalcFriendlyName;
  FLock := 0;
end;

class function TfmBaseCalcForm.CalcFriendlyName: string;
begin
  Result := 'calc';
end;

class function TfmBaseCalcForm.CalcSection: string;
begin
  Result := '';
end;

const dwColor: array[boolean] of TColor = ($008080FF, clWindow);

function TfmBaseCalcForm.CheckField(Obj: TLabeledEdit): single;
begin
  Result := StrToFloatDef(Obj.Text, -1);
  Obj.Color := dwColor[Result>=0];
end;

function TfmBaseCalcForm.CheckField2(Obj: TLabeledEdit; out Value: single): boolean;
begin
  Result := TryStrToFloat(Obj.Text, Value);
  Obj.Color := dwColor[Result];
end;

function TfmBaseCalcForm.CheckFieldMore(Obj: TLabeledEdit; const vmin: single): boolean;
var tmp: single;
begin
  tmp := CheckField(Obj);
  Result := tmp > vmin;
  Obj.Color := dwColor[Result];
end;

function TfmBaseCalcForm.CheckFieldRange(Obj: TLabeledEdit; const vmin,vmax: single; IncEqu: boolean): boolean;
var tmp: single;
begin
  Result := TryStrToFloat(Obj.Text, tmp);
  if not Result then begin
    Self.HighliteErrorField(Obj); exit;
  end;
  
  if IncEqu then
    Result := (tmp>=vmin) and (tmp<=vmax)
  else
    Result := (tmp>vmin) and (tmp<vmax);

  Obj.Color := dwColor[Result];
end;

function TfmBaseCalcForm.CheckField2(Obj: TLabeledEdit; out Value: single;
  const vmin, vmax: single): boolean;
begin
  Result := TryStrToFloat(Obj.Text, Value);
  Obj.Color := dwColor[Result];
  if not Result then exit;
  Result := (Value>=vmin) and (Value<=vmax);
  Obj.Color := dwColor[Result];
end;

function TfmBaseCalcForm.DoCheckFields: boolean;
begin
  Result := false;
end;

procedure TfmBaseCalcForm.DoFieldChanged;
begin
  if (FLock=0) and (DoCheckFields) then FieldsChanged;
end;

procedure TfmBaseCalcForm.FieldsChanged;
begin
  // Override me!
end;

function TfmBaseCalcForm.GetLocaleString(AStringId: string): string;
begin
  Result := uLocalization.GetString('#'+Self.RunKey+'\'+AStringID);
end;

procedure TfmBaseCalcForm.HighliteErrorField(Obj: TLabeledEdit; AError: boolean);
begin
  Obj.Color := dwColor[not AError];
  Obj.Repaint;
end;

class procedure TfmBaseCalcForm.InvokeCalc;
var rs: TStream;
    s: string;
begin
  s := GetString('#'+RunKey+'\title', false);
  if (s<>'') then Application.Title := s
  else Application.Title := Self.CalcFriendlyName;

  s := AppDir+'Data\ICO_'+UpperCase(Self.RunKey)+'.ico';
  try
    if not FileExists(s) then exit;
    rs := TFileStream.Create(s, fmOpenRead); //TResourceStream.Create(hInstance, 'ICO_'+UpperCase(Self.RunKey), RT_ICON);
    try
      rs.Seek(0, soFromBeginning);
      Application.Icon.LoadFromStream(rs);
    finally rs.Free; end;
  except end;
end;

procedure TfmBaseCalcForm.LoadPictureFromRes(APic: TPicture; const AResName: string);
begin
  APic.Bitmap.LoadFromResourceName(hInstance, AResName);
end;

procedure TfmBaseCalcForm.LockFields;
begin
  Inc(FLock);
end;

class function TfmBaseCalcForm.RunKey: string;
begin
  Result := '';
end;

procedure TfmBaseCalcForm.SetLabels(ABaseName, ACaption, AUnit: string);
var com: TComponent;
begin
  com := Self.FindComponent('ed'+ABaseName);
  if (com<>nil) and (com is TLabeledEdit) then
    TLabeledEdit(com).EditLabel.Caption := ACaption;

  com := Self.FindComponent('la'+ABaseName);
  if (com<>nil) and (com is TLabel) then
    TLabel(com).Caption := AUnit;
end;

procedure TfmBaseCalcForm.UnlockFields;
begin
  if (FLock>0) then Dec(FLock);
end;

procedure TfmBaseCalcForm.EnableSet(ABaseName: string; AEnable: boolean);

  procedure _walk(ACom: TComponent);
  var i: integer;//com: TComponent;
  begin
    for i := 0 to ACom.ComponentCount-1 do begin
      if (ACom.Components[i] is TControl) and AnsiEndsText(ABaseName, ACom.Components[i].Name) then
        if (Length(ACom.Components[i].Name)-Length(ABaseName) < 3) then
          TControl(ACom.Components[i]).Enabled := AEnable;
    end;
  end;

begin
  _walk(Self);
end;

procedure TfmBaseCalcForm.LocalizeStrings(AObj: TStrings; ALocal: boolean);
var i: integer;
begin
  for i := 0 to AObj.Count-1 do
    if (ALocal) then AObj[i] := GetLocaleString(AObj[i])
    else AObj[i] := GetString(AObj[i])
end;

procedure TfmBaseCalcForm.ClearSet(ABaseName, ADefault: string);
var com: TComponent;
begin
  com := Self.FindComponent('ed'+ABaseName);
  if (com<>nil) then
    if (com is TLabeledEdit) then TLabeledEdit(com).Text := ADefault
    else
    if (com is TEdit) then TEdit(com).Text := ADefault;
end;

class function TfmBaseCalcForm.IsDebug: boolean;
begin
  Result := false;
end;

procedure TfmBaseCalcForm.LocalizeListColumns(AObj: TListView; ALocal: boolean);
var i: integer;
begin
  for i := 0 to AObj.Columns.Count-1 do
    if (ALocal) then AObj.Columns[i].Caption := GetLocaleString(AObj.Columns[i].Caption)
    else AObj.Columns[i].Caption := GetString(AObj.Columns[i].Caption);
end;

procedure TfmBaseCalcForm.RemoveListDupes(AObj: TListView);
var idx,col: integer;
    stk: TStringList;
    s: string;
begin
  idx := 0;
  stk := TStringList.Create;
  try
    while idx<AObj.Items.Count do begin
      s := AObj.Items[idx].Caption+' ';
      for col := 0 to AObj.Items[idx].SubItems.Count-1 do
        s := AObj.Items[idx].SubItems[col]+' ';
      s := Trim(s);

      if (stk.IndexOf(s)>-1) then
        AObj.Items.Delete(idx)
      else begin
        stk.Add(s);
        Inc(idx);
      end;
    end;
  finally stk.Free; end;
end;

function TfmBaseCalcForm.MessageBox(AText, ATitle: string;
  AFlags: integer): integer;
begin
  Result := Windows.MessageBoxA(Handle, PAnsiChar(AText), PAnsiChar(ATitle), AFlags);
end;

procedure TfmBaseCalcForm.ShowSet(ABaseName: string; AShow: boolean);
var com: TComponent;
begin
  com := Self.FindComponent('ed'+ABaseName);
  if (com<>nil) and (com is TLabeledEdit) then TLabeledEdit(com).Visible := AShow;
  com := Self.FindComponent('la'+ABaseName);
  if (com<>nil) and (com is TLabel) then TLabel(com).Visible := AShow;
end;

function TfmBaseCalcForm.CheckErrorField(Obj: TLabeledEdit;
  ASuccess: boolean): boolean;
begin
  Result := ASuccess;
  Self.HighliteErrorField(Obj, not ASuccess);
end;

end.
